home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / a_utils / flex / aflexx-a / aflex.lha / aflex / src / skeleton_managerB.a < prev    next >
Encoding:
Text File  |  1993-05-31  |  11.2 KB  |  296 lines
  1. -- Copyright (c) 1990 Regents of the University of California.
  2. -- All rights reserved.
  3. --
  4. -- This software was developed by John Self of the Arcadia project
  5. -- at the University of California, Irvine.
  6. --
  7. -- Redistribution and use in source and binary forms are permitted
  8. -- provided that the above copyright notice and this paragraph are
  9. -- duplicated in all such forms and that any documentation,
  10. -- advertising materials, and other materials related to such
  11. -- distribution and use acknowledge that the software was developed
  12. -- by the University of California, Irvine.  The name of the
  13. -- University may not be used to endorse or promote products derived
  14. -- from this software without specific prior written permission.
  15. -- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
  16. -- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
  17. -- WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
  18.  
  19. -- TITLE skeleton manager
  20. -- AUTHOR: John Self (UCI)
  21. -- DESCRIPTION outputs skeleton sections when called by gen.
  22. -- NOTES allows use of internal or external skeleton
  23. -- $Header: /dc/uc/self/arcadia/aflex/ada/src/RCS/skeleton_managerB.a,v 1.19 1992/12/29 22:46:15 self Exp self $ 
  24.  
  25. with MISC_DEFS, TEXT_IO, FILE_STRING;
  26. package body SKELETON_MANAGER is 
  27.   use FILE_STRING; -- to save having to type FILE_STRING 177 times
  28.   USE_EXTERNAL_SKELETON : BOOLEAN := FALSE; 
  29.                                           -- are we using an external skelfile?
  30.   CURRENT_LINE          : INTEGER := 1; 
  31.   type FILE_ARRAY is array(POSITIVE range <>) of FILE_STRING.VSTRING; 
  32.   SKEL_TEMPLATE : constant FILE_ARRAY := (
  33.   -- START OF SKELETON
  34.   -- START OF S1
  35. VSTR("-- A lexical scanner generated by aflex"),
  36. VSTR("with text_io; use text_io;"),
  37. VSTR("%% user's code up to the double pound goes right here"),
  38. -- BEGIN S2
  39. VSTR("function YYLex return Token is"),
  40. VSTR("subtype short is integer range -32768..32767;"),
  41. VSTR("    yy_act : integer;"),
  42. VSTR("    yy_c : short;"),
  43. VSTR(""),
  44. VSTR("-- returned upon end-of-file"),
  45. VSTR("YY_END_TOK : constant integer := 0;"),
  46. VSTR("%% tables get generated here."),
  47. -- BEGIN S3
  48. VSTR(""),
  49. VSTR("-- copy whatever the last rule matched to the standard output"),
  50. VSTR(""),
  51. VSTR("procedure ECHO is"),
  52. VSTR("begin"),
  53. VSTR("   if (text_io.is_open(user_output_file)) then"),
  54. VSTR("     text_io.put( user_output_file, yytext );"),
  55. VSTR("   else"),
  56. VSTR("     text_io.put( yytext );"),
  57. VSTR("   end if;"),
  58. VSTR("end ECHO;"),
  59. VSTR(""),
  60. VSTR("-- enter a start condition."),
  61. VSTR("-- Using procedure requires a () after the ENTER, but makes everything"),
  62. VSTR("-- much neater."),
  63. VSTR(""),
  64. VSTR("procedure ENTER( state : integer ) is"),
  65. VSTR("begin"),
  66. VSTR("     yy_start := 1 + 2 * state;"),
  67. VSTR("end ENTER;"),
  68. VSTR(""),
  69. VSTR("-- action number for EOF rule of a given start state"),
  70. VSTR("function YY_STATE_EOF(state : integer) return integer is"),
  71. VSTR("begin"),
  72. VSTR("     return YY_END_OF_BUFFER + state + 1;"),
  73. VSTR("end YY_STATE_EOF;"),
  74. VSTR(""),
  75. VSTR("-- return all but the first 'n' matched characters back to the input stream"),
  76. VSTR("procedure yyless(n : integer) is"),
  77. VSTR("begin"),
  78. VSTR("        yy_ch_buf(yy_cp) := yy_hold_char; -- undo effects of setting up yytext"),
  79. VSTR("        yy_cp := yy_bp + n;"),
  80. VSTR("        yy_c_buf_p := yy_cp;"),
  81. VSTR("        YY_DO_BEFORE_ACTION; -- set up yytext again"),
  82. VSTR("end yyless;"),
  83. VSTR(""),
  84. VSTR("-- redefine this if you have something you want each time."),
  85. VSTR("procedure YY_USER_ACTION is"),
  86. VSTR("begin"),
  87. VSTR("        null;"),
  88. VSTR("end;"),
  89. VSTR(""),
  90. VSTR("-- yy_get_previous_state - get the state just before the EOB char was reached"),
  91. VSTR(""),
  92. VSTR("function yy_get_previous_state return yy_state_type is"),
  93. VSTR("    yy_current_state : yy_state_type;"),
  94. VSTR("    yy_c : short;"),
  95. VSTR("%% a local declaration of yy_bp goes here if bol_needed"),
  96. VSTR("begin"),
  97. VSTR("%% code to get the start state into yy_current_state goes here"), 
  98. -- BEGIN S3A
  99. VSTR(""),
  100. VSTR("    for yy_cp in yytext_ptr..yy_c_buf_p - 1 loop"),
  101. VSTR("%% code to find the next state goes here"),
  102. -- BEGIN S4
  103. VSTR("    end loop;"),
  104. VSTR(""),
  105. VSTR("    return yy_current_state;"),
  106. VSTR("end yy_get_previous_state;"),
  107. VSTR(""),
  108. VSTR("procedure yyrestart( input_file : file_type ) is"),
  109. VSTR("begin"),
  110. VSTR("   open_input(text_io.name(input_file));"),
  111. VSTR("end yyrestart;"),
  112. VSTR(""),
  113. VSTR("begin -- of YYLex"),
  114. VSTR("<<new_file>>"),
  115. VSTR("        -- this is where we enter upon encountering an end-of-file and"),
  116. VSTR("        -- yywrap() indicating that we should continue processing"),
  117. VSTR(""),
  118. VSTR("    if ( yy_init ) then"),
  119. VSTR("        if ( yy_start = 0 ) then"),
  120. VSTR("            yy_start := 1;      -- first start state"),
  121. VSTR("        end if;"),
  122. VSTR(""),
  123. VSTR("        -- we put in the '\n' and start reading from [1] so that an"),
  124. VSTR("        -- initial match-at-newline will be true."),
  125. VSTR(""),
  126. VSTR("        yy_ch_buf(0) := ASCII.LF;"),
  127. VSTR("        yy_n_chars := 1;"),
  128. VSTR(""),
  129. VSTR("        -- we always need two end-of-buffer characters.  The first causes"),
  130. VSTR("        -- a transition to the end-of-buffer state.  The second causes"),
  131. VSTR("        -- a jam in that state."),
  132. VSTR(""),
  133. VSTR("        yy_ch_buf(yy_n_chars) := YY_END_OF_BUFFER_CHAR;"),
  134. VSTR("        yy_ch_buf(yy_n_chars + 1) := YY_END_OF_BUFFER_CHAR;"),
  135. VSTR(""),
  136. VSTR("        yy_eof_has_been_seen := false;"),
  137. VSTR(""),
  138. VSTR("        yytext_ptr := 1;"),
  139. VSTR("        yy_c_buf_p := yytext_ptr;"),
  140. VSTR("        yy_hold_char := yy_ch_buf(yy_c_buf_p);"),
  141. VSTR("        yy_init := false;"),
  142. VSTR("    end if; -- yy_init"),
  143. VSTR(""),
  144. VSTR("    loop                -- loops until end-of-file is reached"),
  145. VSTR("        yy_cp := yy_c_buf_p;"),
  146. VSTR(""),
  147. VSTR("        -- support of yytext"),
  148. VSTR("        yy_ch_buf(yy_cp) := yy_hold_char;"),
  149. VSTR(""),
  150. VSTR("        -- yy_bp points to the position in yy_ch_buf of the start of the"),
  151. VSTR("        -- current run."),
  152. VSTR("%%"),
  153. -- BEGIN S5
  154. VSTR(""),
  155. VSTR("<<next_action>>"),
  156. VSTR("%% call to gen_find_action goes here"),
  157. -- BEGIN S6
  158. VSTR("            YY_DO_BEFORE_ACTION;"),
  159. VSTR("            YY_USER_ACTION;"),
  160. VSTR(""),
  161. VSTR("        if aflex_debug then  -- output acceptance info. for (-d) debug mode"),
  162. VSTR("            text_io.put( Standard_Error, ""--accepting rule #"" );"),
  163. VSTR("            text_io.put( Standard_Error, INTEGER'IMAGE(yy_act) );"),
  164. VSTR("            text_io.put_line( Standard_Error, ""("""""" & yytext & """""")"");"),
  165. VSTR("        end if;"),
  166. VSTR(""),
  167. VSTR("<<do_action>>   -- this label is used only to access EOF actions"),
  168. VSTR("            case yy_act is"), VSTR("%% actions go here"),
  169. -- BEGIN S7
  170. VSTR("                when YY_END_OF_BUFFER =>"),
  171. VSTR("                    -- undo the effects of YY_DO_BEFORE_ACTION"),
  172. VSTR("                    yy_ch_buf(yy_cp) := yy_hold_char;"),
  173. VSTR(""),
  174. VSTR("                    yytext_ptr := yy_bp;"), VSTR(""),
  175. VSTR("                    case yy_get_next_buffer is"),
  176. VSTR("                        when EOB_ACT_END_OF_FILE =>"),
  177. VSTR("                            begin"),
  178. VSTR("                            if ( yywrap ) then"),
  179. VSTR("                                -- note: because we've taken care in"),
  180. VSTR("                                -- yy_get_next_buffer() to have set up yytext,"),
  181. VSTR("                                -- we can now set up yy_c_buf_p so that if some"),
  182. VSTR("                                -- total hoser (like aflex itself) wants"),
  183. VSTR("                                -- to call the scanner after we return the"),
  184. VSTR("                                -- End_Of_Input, it'll still work - another"),
  185. VSTR("                                -- End_Of_Input will get returned."),
  186. VSTR(""),
  187. VSTR("                                yy_c_buf_p := yytext_ptr;"),
  188. VSTR(""),
  189. VSTR("                                yy_act := YY_STATE_EOF((yy_start - 1) / 2);"),
  190. VSTR(""),
  191. VSTR("                                goto do_action;"),
  192. VSTR("                            else"),
  193. VSTR("                                --  start processing a new file"),
  194. VSTR("                                yy_init := true;"),
  195. VSTR("                                goto new_file;"),
  196. VSTR("                            end if;"),
  197. VSTR("                            end;"),
  198. VSTR("                        when EOB_ACT_RESTART_SCAN =>"),
  199. VSTR("                            yy_c_buf_p := yytext_ptr;"),
  200. VSTR("                            yy_hold_char := yy_ch_buf(yy_c_buf_p);"),
  201. VSTR("                        when EOB_ACT_LAST_MATCH =>"),
  202. VSTR("                            yy_c_buf_p := yy_n_chars;"),
  203. VSTR("                            yy_current_state := yy_get_previous_state;"),
  204. VSTR(""),
  205. VSTR("                            yy_cp := yy_c_buf_p;"),
  206. VSTR("                            yy_bp := yytext_ptr;"),
  207. VSTR("                            goto next_action;"),
  208. VSTR("                        when others => null;"),
  209. VSTR("                        end case; -- case yy_get_next_buffer()"),
  210. VSTR("                when others =>"),
  211. VSTR("                    text_io.put( ""action # "" );"),
  212. VSTR("                    text_io.put( INTEGER'IMAGE(yy_act) );"),
  213. VSTR("                    text_io.new_line;"),
  214. VSTR("                    raise AFLEX_INTERNAL_ERROR;"),
  215. VSTR("            end case; -- case (yy_act)"),
  216. VSTR("        end loop; -- end of@oop waiting for end of file"),
  217. VSTR("end YYLex;"),
  218. VSTR("%%"),
  219. VSTR("ERROR tried to output beyond end of skeleton file")
  220. -- END OF SKELETON
  221. ); 
  222.  
  223.   -- set_external_skeleton
  224.   --
  225.   -- DESCRIPTION
  226.   -- sets flag so we know to use an external skelfile
  227.  
  228.   procedure SET_EXTERNAL_SKELETON is 
  229.   begin
  230.     USE_EXTERNAL_SKELETON := TRUE; 
  231.   end SET_EXTERNAL_SKELETON; 
  232.  
  233.   procedure GET_INTERNAL(BUFFER : in out FILE_STRING.VSTRING) is 
  234.   begin
  235.     BUFFER := SKEL_TEMPLATE(CURRENT_LINE); 
  236.     CURRENT_LINE := CURRENT_LINE + 1; 
  237.   end GET_INTERNAL; 
  238.  
  239.   procedure GET_EXTERNAL(BUFFER : in out FILE_STRING.VSTRING) is 
  240.   begin
  241.     FILE_STRING.GET_LINE(MISC_DEFS.SKELFILE, BUFFER); 
  242.   end GET_EXTERNAL; 
  243.  
  244.   -- end_of_skeleton
  245.   --
  246.   -- DESCRIPTION
  247.   -- returns true if there are no more lines left to output in the skeleton
  248.  
  249.   function END_OF_SKELETON return BOOLEAN is 
  250.   begin
  251.     if (USE_EXTERNAL_SKELETON) then 
  252.  
  253.       -- we're using an external skelfile
  254.       return TEXT_IO.END_OF_FILE(MISC_DEFS.SKELFILE); 
  255.     else 
  256.  
  257.       -- internal skeleton
  258.       return CURRENT_LINE > SKEL_TEMPLATE'LAST; 
  259.     end if; 
  260.   end END_OF_SKELETON; 
  261.  
  262.   procedure GET_FILE_LINE(BUFFER : in out FILE_STRING.VSTRING) is 
  263.   begin
  264.     if (USE_EXTERNAL_SKELETON) then 
  265.       GET_EXTERNAL(BUFFER); 
  266.     else 
  267.       GET_INTERNAL(BUFFER); 
  268.     end if; 
  269.   end GET_FILE_LINE; 
  270.  
  271.   -- skelout - write out one section of the skeleton file
  272.   --
  273.   -- DESCRIPTION
  274.   --    Either outputs internal skeleton, or from a file with "%%" dividers
  275.   --    if a skeleton file is specified by the user.
  276.   --    Copies from skelfile to stdout until a line beginning with "%%" or
  277.   --    EOF is found.
  278.  
  279.   procedure SKELOUT is 
  280.     BUF      : FILE_STRING.VSTRING; 
  281.     LINE_LEN : INTEGER; 
  282.   begin
  283.     while (not END_OF_SKELETON) loop
  284.       GET_FILE_LINE(BUF); 
  285.       if ((FILE_STRING.LEN(BUF) >= 2)
  286.           and then ((FILE_STRING.CHAR(BUF, 1) = '%')
  287.                      and (FILE_STRING.CHAR(BUF, 2) = '%'))) then 
  288.         exit; 
  289.       else 
  290.         FILE_STRING.PUT_LINE(BUF); 
  291.       end if; 
  292.     end loop; 
  293.   end SKELOUT; 
  294.  
  295. end SKELETON_MANAGER; 
  296.